home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / listings / v_03_02 / 3n02035a < prev    next >
Text File  |  1991-11-15  |  4KB  |  182 lines
  1. {FONTS - Extensions to ObjectWindows Copyright (C) Doug Overmyer 10/1/91}
  2. unit Fonts;
  3. interface
  4. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs;
  5.  
  6. type
  7. PIntObj = ^TIntObj;
  8. TIntObj = object(TObject)
  9.     Int:Integer;
  10.   constructor Init(NewInt:Integer);
  11.   destructor Done;virtual;
  12. end;
  13.  
  14. type                          
  15. PFontItem = ^TFontItem;
  16. TFontItem = object(TObject)
  17.     LogFont:TLogFont;
  18.   FontType:Integer;
  19.   Sizes:PCollection;
  20.   constructor Init(NewItem:TLogFont;NewType:Integer);
  21.   destructor Done;virtual;
  22. end;
  23.  
  24. PFontCollection = ^TFontCollection;   
  25. TFontCollection = object(TSortedCollection)
  26.     function KeyOf(Item:Pointer):Pointer;virtual;
  27.   function Compare(Key1,Key2:Pointer):Integer;virtual;
  28.   function GetCount:Integer;virtual;
  29. end;
  30.  
  31. type PFonts = ^TFonts;
  32. TFonts = object
  33.     LogPixlX,LogPixlY:Integer;
  34.   constructor Init;
  35.   destructor Done;virtual;
  36.   procedure ReInit;virtual;
  37.   procedure Enumerate(TheDC:hDC);virtual;
  38.   function At(Index:Integer):pointer;virtual;
  39.   function Count:Integer;virtual;
  40.   function LogPixX:Integer;virtual;
  41.   function LogPixY:Integer;virtual;
  42. end;
  43. {************************  Implementation  **********************}
  44. implementation
  45. {************************  Global Variables  *********************}
  46. var
  47.   Faces:PFontCollection;
  48. {************************  TIntObj     ***************************}
  49. constructor TIntObj.Init(NewInt:Integer);
  50. begin
  51.     Int := NewInt;
  52. end;
  53.  
  54. destructor TIntObj.Done;
  55. begin
  56.     TObject.Done;
  57. end;
  58. {************************  TFontItem    **************************}
  59. constructor TFontItem.Init(NewItem:TLogFont;NewType:Integer);
  60. begin
  61.     LogFont := NewItem;
  62.   FontType := NewType;
  63.   Sizes := New(PCollection,Init(10,10));
  64. end;
  65.  
  66. destructor TFontItem.Done;
  67. begin
  68.     Dispose(Sizes,Done);
  69. end;
  70. {************************  TFontCollection  ************************}
  71. function TFontCollection.KeyOf(Item:Pointer):Pointer;
  72. var
  73.     Ptr :PChar;
  74. begin
  75.     Ptr := PFontItem(Item)^.LogFont.lfFaceName;
  76.     KeyOf := Ptr;
  77. end;
  78.  
  79. function TFontCollection.Compare(Key1,Key2:Pointer):Integer;
  80. begin
  81.     Compare := StrIComp(PChar(Key1),PChar(Key2));
  82. end;
  83.  
  84. function TFontCollection.GetCount:Integer;
  85. begin
  86.     GetCount := Count;
  87. end;
  88. {************************  TFonts             *********************}
  89. constructor TFonts.Init;
  90. begin
  91.     Faces := New(PFontCollection,Init(100,100));
  92.   Faces^.Duplicates := False;
  93.   LogPixlX := 0;
  94.   LogPixlY := 0;
  95. end;
  96.  
  97. destructor TFonts.Done;
  98. begin
  99.     Dispose(Faces,Done);
  100. end;
  101.  
  102. procedure TFonts.ReInit;
  103. begin
  104.     Dispose(Faces,Done);
  105.     Faces := New(PFontCollection,Init(100,100));
  106.   Faces^.Duplicates := False;
  107.   LogPixlX := 0;
  108.   LogPixlY := 0;
  109. end;
  110.  
  111. function EnumerateFace(var LogFont: TLogFont; TextMetric: PTextMetric;
  112.       FontType: Integer; Data: PChar): Integer; export;
  113. begin
  114.    Faces^.Insert(New(PFontItem,Init(LogFont,FontType)));
  115.    EnumerateFace := 1;
  116. end;
  117.  
  118. function EnumerateSize(var LogFont: TLogFont; TextMetric: PTextMetric;
  119.           FontType: Integer; Indx: PChar): Integer; export;
  120.  function DupS(Item:PIntObj):Boolean;far;
  121.       begin
  122.        DupS := (Item^.Int = LogFont.lfHeight);
  123.    end;
  124. var
  125.   Result :PIntObj;
  126.   FI:PFontItem;
  127.   Indxx :Integer;
  128.   Error:Integer;
  129. begin
  130.     Val(Indx,Indxx,Error);
  131.   FI := Faces^.At(Indxx);
  132.   Result := FI^.Sizes^.FirstThat(@DupS);
  133.   if Result = nil then Fi^.Sizes^.AtInsert(0,(New(PIntObj,Init(LogFont.lfHeight)))) ;
  134.     EnumerateSize := 1;
  135. end;
  136.  
  137. procedure TFonts.Enumerate(TheDC:hDC);
  138. var
  139.   EnumProc: TFarProc;
  140.   Indx:Integer;
  141.   pIndx:PChar;
  142.   szIndx:Array[0..25] of Char;
  143.   FontItem :PFontItem;
  144. begin
  145.     pIndx := @szIndx;
  146.     StrCopy(szIndx,'');
  147.   EnumProc := MakeProcInstance(@EnumerateFace, HInstance);
  148.   EnumFonts(TheDC, nil, EnumProc,nil);
  149.   EnumProc := MakeProcInstance(@EnumerateSize, HInstance);
  150.   for Indx := 0 to Faces^.Count -1 do
  151.       begin
  152.     Str(Indx,szIndx);
  153.     FontItem := Faces^.At(Indx);
  154.     EnumFonts(TheDC, FontItem^.LogFont.lfFaceName,
  155.         EnumProc,pIndx);
  156.     end;
  157.   LogPixlX := GetDeviceCaps(TheDC,LogPixelsX);
  158.   LogPixlY := GetDeviceCaps(TheDC,LogPixelsY);
  159. end;
  160.  
  161. function TFonts.At(Index:Integer):Pointer;
  162. begin
  163.     At := Faces^.At(Index);
  164. end;
  165.  
  166. function TFonts.Count:Integer;
  167. begin
  168.     Count := Faces^.Count;
  169. end;
  170.  
  171. function TFonts.LogPixX:Integer;
  172. begin
  173.     LogPixX := LogPixlX;
  174. end;
  175.  
  176. function TFonts.LogPixY:Integer;
  177. begin
  178.     LogPixY := LogPixlY;
  179. end;
  180. {******************************************************************}
  181. end.
  182.